perm filename RECORD.F4[KI,ALS] blob
sn#091985 filedate 1974-03-19 generic text, type T, neo UTF8
00100 SUBROUTINE FMAIN
00200 IMPLICIT INTEGER(A-Z)
00300 DIMENSION A(9216),B(9216),C(9216)
00400 DATA SPEED/25600/
00500 DATA NUM/9216/
00600 CALL TORITE(JFN,'LISTEN.TMP')
00700 CALL SETWRT(1,JFN)
00800 CALL STRNGO('ABOUT TO TRY TO ASSIGN ADC ')
00900 CALL SETAD(11,SPEED)
01000 CALL STRNGO(' - SUCCESSFUL')
01100 CALL LFCR
01200 NSEC=5
01300 NSAMP=25600*NSEC
01400 NWORDS=NSAMP/3
01500 TEST=NSAMP-NWORDS*3
01600 IF(TEST.GT.0)NWORDS=NWORDS+1
01700 NPAGES=NWORDS/512
01800 TEST=NWORDS-512*NPAGES
01900 IF(TEST.GT.0)NPAGES=NPAGES+1
02000 NWORDS=512*NPAGES
02100 NITER=NWORDS/(3*NUM)
02200 NLEFT=NWORDS-3*NUM*NITER
02300 FL1=0
02400 FL2=0
02500 FL3=0
02600 IF(NLEFT.GT.NUM)GO TO 1
02700 NL1=NLEFT
02800 IF(NL1.LE.0)FL1=1
02900 IF(NL1.LE.0)NL1=1
03000 NL2=1
03100 FL2=1
03200 NL3=1
03300 FL3=1
03400 GO TO 3
03500 1 CONTINUE
03600 NL1=NUM
03700 NLEFT=NLEFT-NUM
03800 IF(NLEFT.GT.NUM)GO TO 2
03900 NL2=NLEFT
04000 IF(NL2.LE.0)FL2=1
04100 IF(NL2.LE.0)NL2=1
04200 NL3=1
04300 FL3=1
04400 GO TO 3
04500 2 CONTINUE
04600 NL2=NUM
04700 NL3=NLEFT-NUM
04800 IF(NL3.LE.0)FL3=1
04900 IF(NL3.LE.0)NL3=1
05000 3 CONTINUE
00100 CALL STRNGO('ABOUT TO TRY TO ASSIGN XGP ')
00200 CALL SETXGP
00300 CALL STRNGO(' - SUCCESSFUL')
00400 CALL LFCR
00500 CALL LOCK
00600 IF(NITER.GT.0)GO TO 4
00700 CALL ADINP1(NL1,A)
00800 CALL ADINP2(NL2,B)
00900 CALL ADINP3(NL3,C)
01000 GO TO 7
01100 4 CONTINUE
01200 CALL ADINP1(NUM,A)
01300 CALL ADINP2(NUM,B)
01400 CALL ADINP3(NUM,C)
01500 IF(NITER.LE.1)GO TO 6
01600 DO 5 LLL=2,NITER
01700 CALL FSTOUT(NUM,A)
01800 CALL ADINP1(NUM,A)
01900 CALL FSTOUT(NUM,B)
02000 CALL ADINP2(NUM,B)
02100 CALL FSTOUT(NUM,C)
02200 CALL ADINP3(NUM,C)
02300 5 CONTINUE
02400 6 CONTINUE
02500 CALL FSTOUT(NUM,A)
02600 CALL ADINP1(NL1,A)
02700 CALL FSTOUT(NUM,B)
02800 CALL ADINP2(NL2,B)
02900 CALL FSTOUT(NUM,C)
03000 CALL ADINP3(NL3,C)
03100 7 CONTINUE
03200 IF(FL1.LE.0)CALL FSTOUT(NL1,A)
03300 CALL ADINP1(1,A)
03400 IF(FL2.LE.0)CALL FSTOUT(NL2,B)
03500 CALL ADINP2(1,B)
03600 IF(FL3.LE.0)CALL FSTOUT(NL3,C)
03700 CALL UNLOCK
03800 CALL RELXGP
03900 CALL STRNGO('XGP RELEASED')
04000 CALL LFCR
04100 CALL RELAD
04200 CALL STRNGO('ADC RELEASED')
04300 CALL LFCR
04400 CALL SCLOSE(JFN)
04500 RETURN
04600 END